home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / MUSIUSIC / PLAYERS.LZH / VOC_PC.PKG < prev    next >
Text File  |  1991-01-07  |  4KB  |  111 lines
  1. with calendar;
  2. with rtext_io;
  3.  
  4. package body voc_pc is
  5.  
  6.   procedure halve(voice_block            : in out voice_blocks;
  7.                   automatic_gain_control : in     boolean:=true) is
  8.     function "="(left,right:in voc_data.block_types) return boolean
  9.       renames voc_data."=";
  10.     function "="(left,right:in voc_data.pack_types) return boolean
  11.       renames voc_data."=";
  12.     -- how long to wait before turning volume louder or softer
  13.     turn_louder_lag:constant duration:=0.2;  -- be slow to turn up
  14.     turn_softer_lag:constant duration:=0.02; -- but fast to turn down
  15.     a,b:integer;
  16.     err:integer:=0;
  17.     subtype multiplier_range is integer range 4 .. 32;
  18.     multiplier:multiplier_range:=8; -- starting multiplier
  19.     volume_adjustment_point:constant integer
  20.       :=integer(voice_block.sample_rate*turn_louder_lag);
  21.     too_loud_delta:constant integer
  22.       :=integer(turn_louder_lag/turn_softer_lag);
  23.     error_level:integer:=0;
  24.     j:integer:=1;
  25.   begin
  26.     if voice_block.packing /= voc_data.unpacked then return;end if;
  27.     voice_block.packing:=voc_data.halved;
  28.     voice_block.block_length:=(voice_block.block_length-1)/2;
  29.     for i in 1 .. voice_block.block_length loop
  30.       a:=(integer(voice_block.data(j+1))-integer(voice_block.data(j)))
  31.          *multiplier+128+err;
  32.       if a < 0 then
  33.         err:=a;a:=0;
  34.         error_level:=error_level+too_loud_delta;
  35.       elsif a > 255 then
  36.         err:=a-255;a:=255;
  37.         error_level:=error_level+too_loud_delta;
  38.       else
  39.         error_level:=error_level-1;
  40.         err:=0;
  41.       end if;
  42.       j:=j+1;
  43.       b:=(integer(voice_block.data(j+1))-integer(voice_block.data(j)))
  44.          *multiplier+128+err;
  45.       if b < 0 then
  46.         err:=b;b:=0;
  47.         error_level:=error_level+too_loud_delta;
  48.       elsif b > 255 then
  49.         err:=b-255;b:=255;
  50.         error_level:=error_level+too_loud_delta;
  51.       else
  52.         error_level:=error_level-1;
  53.         err:=0;
  54.       end if;
  55.       j:=j+1;
  56.       if automatic_gain_control then
  57.         if error_level >= volume_adjustment_point then
  58.           if multiplier > multiplier_range'first then
  59.             multiplier:=multiplier-1;
  60.           end if;
  61.           error_level:=0;
  62.         elsif error_level <= -volume_adjustment_point then
  63.           if multiplier < multiplier_range'last then
  64.             multiplier:=multiplier+1;
  65.           end if;
  66.           error_level:=0;
  67.         end if;
  68.       else
  69.         error_level:=0;
  70.       end if;
  71.       a:=(a+7)/16;
  72.       b:=(b+7)/16;
  73.       if a > 15 then a:=15;end if;
  74.       if b > 15 then b:=15;end if;
  75.       if a < 8 then a:=15-a;else a:=a-8;end if;
  76.       if b < 8 then b:=15-b;else b:=b-8;end if;
  77.       voice_block.data(i):=voc_data.sound_bytes(a*16+b);
  78.     end loop;
  79.   end halve;
  80.  
  81.   procedure play(voc_block:in out VOC_data.blocks) is
  82.     function "="(left,right:in voc_data.block_types) return boolean
  83.       renames voc_data."=";
  84.     function "="(left,right:in voc_data.pack_types) return boolean
  85.       renames voc_data."=";
  86.   begin
  87.     if voc_block.block_type = voc_data.silence then
  88.       declare          -- poll for key press for appropriate duration
  89.         use calendar;
  90.         time_to_stop:constant calendar.time
  91.           :=calendar.clock+voc_block.silence_interval;
  92.       begin
  93.         while calendar.clock < time_to_stop loop
  94.           exit when rtext_io.keypress;
  95.         end loop;
  96.       end;
  97.       return;
  98.     end if;
  99.     if voc_block.block_type /= voc_data.voice_data then
  100.       return;
  101.     end if;
  102.     pc_sound.set_sample_rate(voc_block.sample_rate);
  103.     if voc_block.packing=voc_data.unpacked then
  104.         halve(voc_block);
  105.     end if;
  106.     -- other packing styles may generate gibberish
  107.     pc_sound.playback(voc_block.data(1)'address,voc_block.block_length);
  108.   end play;
  109.  
  110. end voc_pc;
  111.